1:-style_check(-discontiguous). 2:-style_check(-singleton). 3
4foreach_with_index(python,Indent,Array,Var,Index,_,Body) -->
5 ("for",python_ws_,Index,python_ws,",",python_ws,Var,python_ws_,"in",python_ws_,"enumerate",python_ws,"(",!,python_ws,Array,python_ws,"):",python_ws,Body).
6foreach_with_index(javascript,Indent,Array,Var,Index,_,Body) -->
7 (Array,ws,".",ws,"forEach",ws,"(",ws,"function",ws,"(",ws,Var,ws,",",!,ws,Index,ws,")",!,ws,"{",!,ws,Body,(Indent;ws),"}",ws,")",ws,";").
8foreach_with_index(php,Indent,Array,Var,Index,_,Body) -->
9 ("foreach",ws,"(",ws,Array,ws_,"as",ws_,Index,ws,"=>",ws,Var,ws,")",ws,"{",!,ws,Body,(Indent;ws),"}"),!.
10foreach_with_index(ruby,Indent,Array,Var,Index,_,Body) -->
11 (Array,ws,".",ws,"each_with_index",ws_,"do",ws,"|",ws,Var,ws,",",ws,Index,ws,"|",ws,Body,(Indent;ws_),"end").
12foreach_with_index(swift,Indent,Array,Var,Index,_,Body) -->
13 ("for",ws,"(",ws,Index,ws,",",!,ws,Var,ws,")",!,ws_,"in",ws_,Array,ws,".",ws,"enumerated",ws,"(",ws,")",!,ws,"{",!,ws,Body,(Indent;ws),"}"),!.
14foreach_with_index(lua,Indent,Array,Var,Index,_,Body) -->
15 ("for",ws_,Index,ws,",",ws,Var,ws_,"in",ws_,"pairs",ws,"(",ws,Array,ws,")",!,ws_,"do",ws_,Body,(Indent;ws_),"end"),!.
16foreach_with_index('c#',Indent,Array,Var,Index,Type,Body) -->
17 ("for",ws,"(",ws,"int",ws_,Index,ws,"=",ws,"0",ws,";",ws,Index,ws,"<",ws,Array,ws,".",ws,"Length",ws,";",ws,Index,ws,"++",ws,")","{",(indent(Indent);ws),Var,ws,"=",ws,Array,ws,"[",ws,Index,ws,"]",ws,";",ws,Body,(Indent;ws),"}"),!.
18foreach_with_index('java',Indent,Array,Var,Index,Type,Body) -->
19 ("for",ws,"(",ws,"int",ws_,Index,ws,"=",ws,"0",ws,";",ws,Index,ws,"<",ws,Array,ws,".",ws,"length",ws,";",ws,Index,ws,"++",ws,")",ws,"{",(indent(Indent);ws),Var,ws,"=",ws,Array,ws,"[",ws,Index,ws,"]",ws,";",ws,Body,(Indent;ws),"}"),!.
20foreach_with_index('javascript',Indent,Array,Var,Index,Type,Body) -->
21 ("for",ws,"(",ws,"var",ws_,Index,ws,"=",ws,"0",ws,";",ws,Index,ws,"<",ws,Array,ws,".",ws,"length",ws,";",ws,Index,ws,"++",ws,")",ws,"{",(indent(Indent);ws),Var,ws,"=",ws,Array,ws,"[",ws,Index,ws,"]",ws,";",ws,Body,(Indent;ws),"}"),!.
22foreach_with_index('c++',Indent,Array,Var,Index,Type,Body) -->
23 ("for",ws,"(",ws,"int",ws_,Index,ws,"=",ws,"0",ws,";",ws,Index,ws,"<",ws,Array,ws,".",ws,"size",ws,"(",ws,")",ws,";",ws,Index,ws,"++",ws,")","{",(indent(Indent);ws),Var,ws,"=",ws,Array,ws,"[",ws,Index,ws,"]",ws,";",ws,Body,(Indent;ws),"}"),!.
24
25
26for_('c',Indent,Initialize,Condition,Update,Body) -->
27 "for",ws,"(",!,ws,Initialize,ws,";",!,ws,Condition,ws,";",!,ws,Update,ws,")",!,ws,"{",!,ws,Body,(Indent;ws),"}",!.
28for_('java',Indent,Initialize,Condition,Update,Body) --> for_('c',Indent,Initialize,Condition,Update,Body),!.
29for_('c#',Indent,Initialize,Condition,Update,Body) --> for_('c',Indent,Initialize,Condition,Update,Body),!.
30for_('c++',Indent,Initialize,Condition,Update,Body) --> for_('c',Indent,Initialize,Condition,Update,Body),!.
31for_('perl',Indent,Initialize,Condition,Update,Body) --> for_('c',Indent,Initialize,Condition,Update,Body),!.
32for_('javascript',Indent,Initialize,Condition,Update,Body) --> for_('c',Indent,Initialize,Condition,Update,Body),!.
33for_('php',Indent,Initialize,Condition,Update,Body) --> for_('c',Indent,Initialize,Condition,Update,Body),!.
34for_('typescript',Indent,Initialize,Condition,Update,Body) --> for_('c',Indent,Initialize,Condition,Update,Body),!.
35
36range_(python,A,B) -->
37 "range",ws,"(",!,ws,A,ws,",",!,ws,B,ws,")",!.
38
39range_(ruby,A,B) -->
40 A,ws,"..",ws,"(",ws,B,ws,"-",ws,"1",ws,")".
41
42not_(python,A) --> "not",ws_,A.
43not_(lua,A) --> "not",ws_,A.
44not_(c,A) --> "!",!,ws,A.
45not_(java,A) --> "!",!,ws,A.
46not_(haxe,A) --> "!",!,ws,A.
47not_('c++',A) --> "!",!,ws,A.
48not_('c#',A) --> "!",!,ws,A.
49not_('php',A) --> "!",!,ws,A.
50not_(perl,A) --> "!",!,ws,A.
51not_(ruby,A) --> "!",!,ws,A.
52not_(javascript,A) --> "!",!,ws,A.
53not_(typescript,A) --> "!",!,ws,A.
54
55minus_minus('javascript',A) --> minus_minus('c',A).
56minus_minus('c++',A) --> minus_minus('c',A).
57minus_minus('c#',A) --> minus_minus('c',A).
58minus_minus('java',A) --> minus_minus('c',A).
59minus_minus('c',A) -->
60 A,ws,"--".
61minus_minus('ruby',A) --> A,ws,"=",ws,A,ws,"+",ws,"1".
62
63plus_plus('javascript',A) --> plus_plus('c',A).
64plus_plus('c++',A) --> plus_plus('c',A).
65plus_plus('php',A) --> plus_plus('c',A).
66plus_plus('c#',A) --> plus_plus('c',A).
67plus_plus('java',A) --> plus_plus('c',A).
68plus_plus('ruby',A) --> A,ws,"=",ws,A,ws,"+",ws,"1".
69plus_plus('c',A) -->
70 A,ws,"++".
71
72top_level_statement('python',Indent,A) --> statement('python',Indent,A).
73top_level_statement('c++',Indent,A) --> statement('c++',Indent,A).
74top_level_statement('erlang',Indent,A) --> statement('erlang',Indent,A),".".
75top_level_statement('prolog',Indent,A) --> statement('prolog',Indent,A),".".
76top_level_statement('picat',Indent,A) --> statement('picat',Indent,A),".".
77top_level_statement('c',Indent,A) --> statement('c',Indent,A).
78top_level_statement('minizinc',Indent,A) --> statement('minizinc',Indent,A),";".
79top_level_statement('d',Indent,A) --> statement('d',Indent,A).
80top_level_statement('c#',Indent,A) --> statement('c#',Indent,A).
81top_level_statement('lua',Indent,A) --> statement('lua',Indent,A).
82top_level_statement('swift',Indent,A) --> statement('swift',Indent,A).
83top_level_statement('ruby',Indent,A) --> statement('ruby',Indent,A).
84top_level_statement('javascript',Indent,A) --> statement('javascript',Indent,A).
85top_level_statement('php',Indent,A) --> statement('php',Indent,A).
86top_level_statement('perl',Indent,A) --> statement('perl',Indent,A).
87top_level_statement('java',Indent,A) --> statement('java',Indent,A).
88top_level_statement('haxe',Indent,A) --> statement('haxe',Indent,A).
89top_level_statement('dart',Indent,A) --> statement('dart',Indent,A).
90
91
92
93top_level_statement_separator('python') --> ws.
94top_level_statement_separator('c++') --> ws.
95top_level_statement_separator('rust') --> ws.
96top_level_statement_separator('erlang') --> ws.
97top_level_statement_separator('prolog') --> ws.
98top_level_statement_separator('c') --> ws.
99top_level_statement_separator('minizinc') --> ws.
100top_level_statement_separator('d') --> ws.
101top_level_statement_separator('c#') --> ws.
102top_level_statement_separator('lua') --> ws_.
103top_level_statement_separator('swift') --> ws_.
104top_level_statement_separator('ruby') --> ws_.
105top_level_statement_separator('javascript') --> ws.
106top_level_statement_separator('php') --> ws.
107top_level_statement_separator('perl') --> ws.
108top_level_statement_separator('java') --> ws.
109top_level_statement_separator('haxe') --> ws.
110top_level_statement_separator('dart') --> ws.
111
112statement_separator('python') --> ws.
113statement_separator('c++') --> ws.
114statement_separator('rust') --> ws.
115statement_separator('erlang') --> ws,",",ws.
116statement_separator('prolog') --> ws,",",ws.
117statement_separator('c') --> ws.
118statement_separator('minizinc') --> ws.
119statement_separator('d') --> ws.
120statement_separator('c#') --> ws.
121statement_separator('lua') --> ws_.
122statement_separator('swift') --> ws_.
123statement_separator('ruby') --> ws_.
124statement_separator('javascript') --> ws.
125statement_separator('php') --> ws.
126statement_separator('perl') --> ws.
127statement_separator('java') --> ws.
128statement_separator('haxe') --> ws.
129statement_separator('dart') --> ws.
130
131scalar_type('minizinc',number) --> "float".
132scalar_type('minizinc',int) --> "int".
133
134scalar_type('java',char) --> "char".
135scalar_type('c++',char) --> "char".
136scalar_type('c',char) --> "char".
137scalar_type('haxe',number) --> "Float".
138scalar_type('haxe',string) --> "String".
139scalar_type('haxe',int) --> "Int".
140scalar_type('haxe',bool) --> "Bool".
141scalar_type('python',string) --> "str".
142scalar_type('c++',number) --> "double".
143scalar_type('java',int) --> "int".
144scalar_type('java',number) --> "double".
145scalar_type('c',number) --> "double".
146scalar_type('c',int) --> "int".
147scalar_type('c++',int) --> "int".
148scalar_type('c++',bool) --> "bool".
149scalar_type('c#',int) --> "int".
150scalar_type('python',int) --> "int".
151scalar_type('python',number) --> "float".
152scalar_type('c',bool) --> "bool".
153scalar_type('java',bool) --> "boolean".
154scalar_type('c#',bool) --> "bool".
155scalar_type('c#',number) --> "double".
156scalar_type('c#',string) --> "string".
157scalar_type('c++',string) --> "string".
158scalar_type('c',string) --> "char*".
159scalar_type('java',string) --> "String".
160
161type(Lang,A) --> scalar_type(Lang,A).
162
163type('java',[array,Type]) --> scalar_type(java,Type),"[]".
164type('c#',[array,Type]) --> scalar_type(java,Type),"[]".
165type('c++',[array,Type]) --> "vector<",ws,scalar_type('c++',Type),">".
166
168first_char_uppercase(WordLC, WordUC) :-
169 atom_chars(WordLC, [FirstChLow|LWordLC]),
170 atom_chars(FirstLow, [FirstChLow]),
171 upcase_atom(FirstLow, FirstUpp),
172 atom_chars(FirstUpp, [FirstChUpp]),
173 atom_chars(WordUC, [FirstChUpp|LWordLC]).
174
178var_name_(prolog,_,A) --> A.
179var_name_('rust',_,A) --> A.
180var_name_(erlang,_,A) --> A.
181var_name_(minizinc,_,A) --> A.
182var_name_(python,_,A) --> A.
183var_name_(sympy,_,A) --> A.
184var_name_(cython,_,A) --> A.
185var_name_(java,_,A) --> A.
186var_name_(dart,_,A) --> A.
187var_name_(swift,_,A) --> A.
188var_name_(javascript,_,A) --> A,!.
189var_name_(ruby,_,A) --> A.
190var_name_(haxe,_,A) --> A.
191var_name_('c#',_,A) --> A.
192var_name_(lua,_,A) --> A.
193var_name_('c++',_,A) --> A.
194var_name_(c,_,A) --> A.
195var_name_(php,_,A) --> "$",A.
196var_name_(perl,Type,A) --> "$",A,{member(Type,[int,double,string,number,bool])}.
197var_name_(perl,[array,_],A) --> "@",A.
198
199parameter_(cython,_,A) --> A.
200parameter_(sympy,_,A) --> A.
201parameter_(python,_,A) --> A.
202parameter_(sympy,_,A) --> A.
203parameter_(erlang,_,A) --> A.
204parameter_(prolog,_,A) --> A.
205parameter_(javascript,_,A) --> A.
206parameter_(perl,_,A) --> A.
207parameter_(php,_,A) --> A.
208parameter_(lua,_,A) --> A.
209parameter_(ruby,_,A) --> A.
210parameter_(javascript,_,A) --> A,!.
211parameter_('java',Type,A) --> Type,ws_,A.
212parameter_('c#',Type,A) --> Type,ws_,A.
213parameter_('c++',Type,A) --> Type,ws_,A.
214parameter_('c',Type,A) --> Type,ws_,A.
215parameter_('haxe',Type,A) --> A,ws,":",ws,Type.
216parameter_('swift',Type,A) --> A,ws,":",ws,Type.
217parameter_('typescript',Type,A) --> A,ws,":",ws,Type.
218parameter_('visual basic',Type,A) --> A,ws_,"as",ws_,Type.
219
220randint(python,A,B) -->
221 "random",python_ws,".",python_ws,"randint",python_ws,"(",A,python_ws,",",python_ws,B,")".
222
223minus_equals_(lua,A,B) --> A,ws,"=",ws,A,ws,"-",ws,B.
224minus_equals_(cython,A,B) --> A,python_ws,"-=",python_ws,B.
225minus_equals_(python,A,B) --> A,python_ws,"-=",python_ws,B.
226minus_equals_(coffeescript,A,B) --> A,python_ws,"-=",python_ws,B.
227minus_equals_(c,A,B) --> A,ws,"-=",!,ws,B.
228minus_equals_(php,A,B) --> A,ws,"-=",!,ws,B.
229minus_equals_('c++',A,B) --> A,ws,"-=",!,ws,B.
230minus_equals_(java,A,B) --> A,ws,"-=",!,ws,B.
231minus_equals_(perl,A,B) --> A,ws,"-=",!,ws,B.
232minus_equals_('c#',A,B) --> A,ws,"-=",!,ws,B.
233minus_equals_(javascript,A,B) --> A,ws,"-=",!,ws,B.
234minus_equals_(c,A,B) --> A,ws,"-=",!,ws,B.
235minus_equals_(haxe,A,B) --> A,ws,"-=",!,ws,B.
236minus_equals_(ruby,A,B) --> A,ws,"-=",!,ws,B.
237
238times_equals_(cython,A,B) --> A,python_ws,"*=",python_ws,B.
239times_equals_(python,A,B) --> A,python_ws,"*=",python_ws,B.
240times_equals_(lua,A,B) --> A,ws,"=",!,ws,A,ws,"*",ws,B.
241times_equals_(coffeescript,A,B) --> A,python_ws,"*=",python_ws,B.
242times_equals_(c,A,B) --> A,ws,"*=",!,ws,B.
243times_equals_(php,A,B) --> A,ws,"*=",!,ws,B.
244times_equals_(haxe,A,B) --> A,ws,"*=",!,ws,B.
245times_equals_(java,A,B) --> A,ws,"*=",!,ws,B.
246times_equals_('c#',A,B) --> A,ws,"*=",!,ws,B.
247times_equals_('c++',A,B) --> A,ws,"*=",!,ws,B.
248times_equals_(javascript,A,B) --> A,ws,"*=",!,ws,B.
249times_equals_(perl,A,B) --> A,ws,"*=",!,ws,B.
250times_equals_(c,A,B) --> A,ws,"*=",!,ws,B.
251times_equals_(ruby,A,B) --> A,ws,"*=",!,ws,B.
252
253divide_equals_(cython,A,B) --> A,python_ws,"/=",python_ws,B.
254divide_equals_(lua,A,B) --> A,ws,"=",!,ws,A,ws,"/",ws,B.
255divide_equals_(python,A,B) --> A,python_ws,"/=",python_ws,B.
256divide_equals_('c++',A,B) --> A,ws,"/=",!,ws,B.
257divide_equals_('java',A,B) --> A,ws,"/=",!,ws,B.
258divide_equals_('c#',A,B) --> A,ws,"/=",!,ws,B.
259divide_equals_(javascript,A,B) --> A,ws,"/=",!,ws,B.
260divide_equals_(c,A,B) --> A,ws,"/=",!,ws,B.
261divide_equals_(ruby,A,B) --> A,ws,"/=",!,ws,B.
262divide_equals_(haxe,A,B) --> A,ws,"/=",!,ws,B.
263divide_equals_(perl,A,B) --> A,ws,"/=",!,ws,B.
264
265
266plus_equals_(perl,number,A,B) --> plus_equals_(c,number,A,B).
267plus_equals_(c,number,A,B) --> A,ws,"+=",!,ws,B.
268plus_equals_(haxe,Type,A,B) --> {member(Type,[string,number])},A,ws,"+=",!,ws,B.
269plus_equals_(php,number,A,B) --> plus_equals_(c,number,A,B).
270plus_equals_(php,string,A,B) --> A,ws,".=",ws,B.
271plus_equals_(perl,string,A,B) --> A,ws,".=",ws,B.
272plus_equals_(perl,[array,_],A,B) -->
273 "push",ws_,A,ws,",",ws,B.
274plus_equals_(php,[array,Type],A,B) -->
275 A,ws,"=",ws,"array_merge",ws,"(",ws,A,ws,",",ws,B,ws,")".
276plus_equals_(lua,string,A,B) --> A,ws,"=",!,ws,A,ws,"..",ws,B.
277plus_equals_(lua,number,A,B) --> A,ws,"=",!,ws,A,ws,"+",ws,B.
278plus_equals_(python,_,A,B) --> A,python_ws,"+=",python_ws,B.
279plus_equals_(ruby,_,A,B) --> A,ws,"+=",!,ws,B.
280plus_equals_(javascript,[array,_],A,B) -->
281 A,ws,"=",ws,A,ws,".",ws,"concat",ws,"(",ws,B,ws,")".
282plus_equals_(javascript,_,A,B) --> A,ws,"+=",!,ws,B.
283plus_equals_(java,Type,A,B) --> {member(Type,[string,number])},A,ws,"+=",!,ws,B.
284plus_equals_('c#',Type,A,B) --> {member(Type,[string,number])},A,ws,"+=",!,ws,B.
285plus_equals_('c++',Type,A,B) --> {member(Type,[string,number])},A,ws,"+=",!,ws,B.
286plus_equals_('c++',[array,_],A,B) --> A,ws,".",ws,"insert",ws,"(",ws,A,ws,".",ws,"end",ws,"(",ws,")",ws,",",ws,B,ws,".",ws,"begin",ws,"(",ws,")",ws,",",ws,B,ws,".",ws,"end",ws,"(",ws,")",ws,")".
287
288floor_(python,A) -->
289 ("math",python_ws,".",python_ws,"floor",python_ws,"(",!,python_ws,A,python_ws,")"),!.
290
291ceiling_(python,A) -->
292 ("math",python_ws,".",python_ws,"ceiling",python_ws,"(",!,python_ws,A,python_ws,")"),!.
293
294
295random_from_list(python,Arr) -->
296 ("random",python_ws,".",python_ws,"choice",python_ws,"(",!,python_ws,Arr,python_ws,")"),!.
297random_from_list(php,Arr) -->
298 ("array_rand",ws,"(",!,ws,Arr,ws,")"),!.
299random_from_list(julia,Arr) -->
300 ("rand",ws,"(",!,ws,Arr,ws,")"),!.
301random_from_list(ruby,Arr) -->
302 (Arr,ws,".",ws,"sample").
303random_from_list('perl 6',Arr) -->
304 (Arr,ws,".",ws,"pick").
305random_from_list(wolfram,Arr) -->
306 ("RandomChoice",ws,"[",ws,Arr,ws,"]").
307random_from_list(coffeescript,Arr) -->
308 random_from_list(javascript,Arr).
309random_from_list(javascript,Arr) -->
310 (Arr,python_ws,"[",ws,"Math",ws,".",ws,"floor",ws,"(",ws,"Math",ws,".",ws,"random",ws,"(",ws,")",ws,"*",python_ws,Arr,python_ws,".",ws,"length",ws,")",ws,"]").
311
312
313
314split_(python,string,Str,Sep) -->
315 (Str,python_ws,".",python_ws,"split",python_ws,"(",!,python_ws,Sep,python_ws,")").
316split_(java,string,Str,Sep) --> split_(python,string,Str,Sep).
317split_(ruby,string,Str,Sep) --> split_(python,string,Str,Sep).
318split_(haxe,string,Str,Sep) --> split_(python,string,Str,Sep).
319split_(rust,string,Str,Sep) --> split_(python,string,Str,Sep).
320split_(vala,string,Str,Sep) --> split_(python,string,Str,Sep).
321split_(javascript,string,Str,Sep) --> split_(python,string,Str,Sep).
322split_(cython,string,Str,Sep) --> split_(python,string,Str,Sep).
323split_(dart,string,Str,Sep) --> split_(python,string,Str,Sep).
324split_(go,string,Str,Sep) -->
325 ("strings",ws,".",ws,"Split",ws,"(",!,ws,Str,ws,",",!,ws,Sep,ws,")").
326split_('c#',string,AString,Separator) -->
327 (AString,ws,".",ws,"Split",ws,"(",ws,"new",ws,"string[]",ws,"{",ws,Separator,ws,"}",ws,",",ws,"StringSplitOptions",ws,".",ws,"None",ws,")").
328split_('php',string,AString,Separator) -->
329 ("explode",ws,"(",!,ws,Separator,ws,",",!,ws,AString,ws,")").
330split_('haskell',string,AString,Separator) -->
331 ("(",ws,"splitOn",ws_,AString,ws_,Separator,ws,")").
332split_('perl',string,AString,Separator) -->
333 ("split",ws,"(",!,ws,Separator,ws,",",!,ws,AString,ws,")").
334
335join_(Lang,Array,Separator) -->
336 {memberchk(Lang,['javascript','haxe','groovy','java','typescript','rust','dart','ruby'])},
337 (Array,ws,".",ws,"join",ws,"(",!,ws,Separator,ws,")"),!.
338join_(php,Array,Separator) -->
339 ("implode",ws,"(",!,ws,Separator,ws,",",!,ws,Array,ws,")").
340join_(python,Arr,Sep) -->
341 (Sep,python_ws,".",python_ws,"join",python_ws,"(",!,python_ws,Arr,python_ws,")").
342join_('c#',Array,Separator) -->
343 ("String",ws,".",ws,"Join",ws,"(",!,ws,Separator,ws,",",!,ws,Array,ws,")").
344
345replace_(swift,string,Str,Sub,Replacement) -->
346 (Str,ws,".",ws,"stringByReplacingOccurrencesOfString",ws,"(",!,ws,Sub,ws,",",!,ws,"withString:",ws,Replacement,ws,")").
347replace_(python,string,A,B,C) -->
348 A,python_ws,".",python_ws,"replace",python_ws,"(",!,python_ws,B,python_ws,",",!,python_ws,C,python_ws,")",!.
349replace_(ruby,string,A,B,C) -->
350 A,ws,".",ws,"gsub",ws,"(",!,ws,B,ws,",",!,ws,C,ws,")",!.
351replace_(haxe,string,Str,Sub,Replacement) -->
352 ("StringTools",ws,".",ws,"replace",ws,"(",!,ws,Str,ws,",",!,ws,Sub,ws,Replacement,ws,")"),!.
353replace_(java,string,A,B,C) -->
354 replace_(python,string,A,B,C).
357replace_('c++',string,Str,Sub,Replacement) -->
358 (Str,ws,".",ws,"replace",ws,"(",ws,"s",ws,".",ws,"find",ws,"(",ws,Sub,ws,")",ws,",",Sub,".",ws,"length",ws,"(",ws,")",ws,",",ws,Replacement,ws,")").
359replace_('c#',string,Str,Sub,Replacement) -->
360 (Str,ws,".",ws,"Replace",ws,"(",!,ws,Sub,ws,",",!,ws,Replacement,ws,")"),!.
361replace_('php',string,Str,Sub,Replacement) -->
362 ("str_replace",ws,"(",!,ws,Sub,ws,",",!,ws,Replacement,ws,",",!,ws,Str,ws,")"),!.
363
364initialize_constant_(minizinc,Type,Name,Value) --> (Type,ws,":",ws,Name,ws,"=",!,ws,Value).
365initialize_constant_(seed7,Type,Name,Value) --> ("const",ws_,Type,ws,":",ws,Name,ws_,"is",ws_,Value).
366initialize_constant_('perl 6',Type,Name,Value) --> ("constant",ws_,Type,ws_,Name,ws,"=",ws,Value).
367initialize_constant_('php',Type,Name,Value) --> ("const",ws_,Name,ws,"=",ws,Value).
368initialize_constant_('javascript',Type,Name,Value) --> ("const",ws_,Name,ws,"=",!,ws,Value).
369initialize_constant_('dart',Type,Name,Value) --> ("const",ws_,Name,ws,"=",!,ws,Value).
370initialize_constant_('go',Type,Name,Value) --> ("const",ws_,Type,ws_,Name,ws,"=",ws,Value).
371initialize_constant_('rust',Type,Name,Value) --> ("let",ws_,Name,ws,"=",ws,Value).
372initialize_constant_('swift',Type,Name,Value) --> ("let",ws_,Name,ws,"=",ws,Value).
373initialize_constant_('java',Type,Name,Value) --> ("final",ws_,Type,ws_,Name,ws,"=",!,ws,Value).
374initialize_constant_('dart',Type,Name,Value) --> ("final",ws_,Type,ws_,Name,ws,"=",!,ws,Value).
375initialize_constant_('c',Type,Name,Value) --> ("static",ws_,"const",ws_,Name,ws,"=",!,ws,Value).
376initialize_constant_(erlang,_,A,B) --> A,ws,"=",ws,B.
377initialize_constant_(minizinc,_,A,B) -->
378 (Type,ws,":",ws,Name,ws,"=",ws,Value).
379
380initialize_constant_(minizinc,Type,Name) --> (Type,ws,":",ws,Name).
381initialize_constant_('c',Type,Name) --> ("static",ws_,"const",ws_,Name).
382initialize_constant_('javascript',Type,Name) --> ("const",ws_,Name).
383initialize_constant_('typescript',Type,Name) --> ("const",ws_,Name).
384initialize_constant_('php',Type,Name) --> ("const",ws_,Name).
385initialize_constant_('dart',Type,Name) --> ("const",ws_,Name).
386initialize_constant_('go',Type,Name) --> ("const",ws_,Name).
387initialize_constant_('perl 6',Type,Name) --> ("constant",ws_,Type,ws_,Name).
388initialize_constant_('typescript',Type,Name) --> "const",ws_,Name,ws,":",ws,Type.
389initialize_constant_('java',Type,Name) --> ("final",ws_,Type,ws_,Name).
390initialize_constant_('c#',Type,Name) --> ("final",ws_,Type,ws_,Name).
391
392assert_(python,A) --> "assert",python_ws,"(",!,python_ws,A,python_ws,")",!.
393assert_(coffeescript,A) --> "assert",python_ws,"(",!,python_ws,A,python_ws,")",!.
394assert_(javascript,A) --> "assert",ws,"(",!,ws,A,ws,")",!.
395assert_(typescript,A) --> "assert",ws,"(",!,ws,A,ws,")",!.
396assert_('c++',A) --> "assert",ws,"(",!,ws,A,ws,")",!.
397assert_(lua,A) --> "assert",ws,"(",!,ws,A,ws,")",!.
398assert_(swift,A) --> "assert",ws,"(",!,ws,A,ws,")",!.
399assert_(php,A) --> "assert",ws,"(",!,ws,A,ws,")",!.
400assert_(scala,A) --> "assert",ws,"(",!,ws,A,ws,")",!.
401assert_(ceylon,A) --> "assert",ws,"(",!,ws,A,ws,")",!.
402
403return_(coffeescript,_,A) --> return_(python,A).
404return_(prolog,_,A) --> "Return",ws,"=",ws,A.
405return_(python,_,A) --> "return",python_ws_,A.
406return(sympy,_,A) --> return_(python,_,A).
407return_(cython,_,A) --> "return",python_ws_,A.
408return_(sympy,_,A) --> "return",python_ws_,A.
409return_(c,_,A) --> "return",ws_,A.
410return_(java,_,A) --> return_(c,_,A).
411return_(erlang,_,A) --> A.
412return_(php,_,A) --> return_(c,_,A).
413return_(perl,_,A) --> return_(c,_,A).
414return_('c++',_,A) --> return_(c,_,A).
415return_(swift,_,A) --> return_(c,_,A).
416return_('c#',_,A) --> return_(c,_,A).
417return_('rust',_,A) --> return_(c,_,A).
418return_(ruby,_,A) --> return_(c,_,A).
419return_(lua,_,A) --> return_(c,_,A).
420return_(javascript,_,A) --> return_(c,_,A).
421return_(typescript,_,A) --> return_(c,_,A).
422return_(haxe,_,A) --> return_(c,_,A).
423
424initialize_var_(javascript,_,Name) -->
425 "var",ws_,Name.
426initialize_var_(java,Type,Name) -->
427 Type,ws_,Name.
428initialize_var_('c#',Type,Name) -->
429 Type,ws_,Name.
430initialize_var_('lua',Type,Name) -->
431 "local",ws_,Name.
432initialize_constant_(minizinc,Type,A,B) -->
433 (Type,ws,":",ws,Name,ws,"=",ws,Value).
434initialize_var_(rust,_,A,B) -->
435 ("let",ws_,"mut",ws_,Name,ws,"=",!,ws,Expr).
436initialize_var_(prolog,type(prolog,[array,_]),A,B) --> A,ws,"=",ws,B.
437initialize_var_(prolog,type(prolog,number),A,B) --> A,ws_,"is",ws_,B.
438initialize_var_(prolog,type(prolog,int),A,B) --> A,ws_,"is",ws_,B.
439initialize_var_(sympy,type(sympy,Type),A,B) --> equals_(sympy,Type,A,B).
440initialize_var_(python,_,A,B) --> A,python_ws,"=",python_ws,B.
441initialize_var_(sympy,_,A,B) --> "Eq",python_ws,"(",A,python_ws,",",python_ws,B,python_ws,")".
442initialize_var_(ruby,_,A,B) --> A,ws,"=",!,ws,B.
443initialize_var_(erlang,_,A,B) --> A,ws,"=",ws,B.
444initialize_var_(php,_,A,B) --> A,ws,"=",!,ws,B.
445initialize_var_(swift,Type,A,B) --> initialize_var_(javascript,Type,A,B).
446initialize_var_(javascript,_,A,B) --> "var",ws_,A,ws,"=",!,ws,B.
447initialize_var_(haxe,Type,A,B) --> initialize_var_(javascript,Type,A,B).
448initialize_var_(dart,Type,A,B) --> initialize_var_(javascript,Type,A,B).
449initialize_var_(lua,_,A,B) --> "local",ws_,A,ws,"=",!,ws,B.
450initialize_var_(perl,_,A,B) --> "my",ws_,A,ws,"=",!,ws,B.
451initialize_var_('c++',Type,A,B) --> Type,ws_,A,ws,"=",!,ws,B.
452initialize_var_('c#',Type,A,B) --> Type,ws_,A,ws,"=",!,ws,B.
453initialize_var_('java',Type,A,B) --> Type,ws_,A,ws,"=",!,ws,B.
454initialize_var_('c',Type,A,B) --> Type,ws_,A,ws,"=",!,ws,B.
455initialize_var_('c',type(c,string),A,B) --> "char",ws_,A,"[]",ws,"=",!,ws,B.
456initialize_var_('c',type(c,[array,Type]),A,B) --> type(c,Type),ws_,A,"[]",ws,"=",!,ws,B.
457
458println_(prolog,_,A) --> ("writeln",ws,"(",!,ws,A,ws,")"),!.
459println_(erlang,_,A) --> ("io",ws,":",ws,"fwrite",ws,"(",!,ws,A,ws,")").
460println_(sympy,Type,A) --> println_(python,Type,A).
461println_(python,_,A) -->
462 "print",python_ws,"(",!,python_ws,A,python_ws,")",!.
463println_(javascript,_,A) -->
464 "console",ws,".",ws,"log",ws,"(",!,ws,A,ws,")",!.
465println_(ruby,_,A) -->
466 "puts",ws,"(",!,ws,A,ws,")",!.
467println_('java',_,A) -->
468 "System",ws,".",ws,"out",ws,".",ws,"println",python_ws,"(",!,python_ws,A,python_ws,")",!.
469println_('c#',_,A) -->
470 "Console",ws,".",ws,"WriteLn",python_ws,"(",!,python_ws,A,python_ws,")",!.
471println_(dart,_,A) --> println_(lua,_,A).
472println_(perl,_,A) --> println_(lua,_,A).
473println_(lua,_,A) -->
474 "print",ws,"(",!,ws,A,ws,")",!.
475println_(haxe,_,A) -->
476 println_(lua,_,A).
477println_(swift_,A) --> println_(lua,_,A).
478println_(c,int,A) -->
479 "printf",ws,"(",!,ws,"\"%d\"",ws,",",!,ws,A,ws,")",!.
480println_(c,string,A) -->
481 "printf",ws,"(",!,ws,"\"%s\"",ws,",",!,ws,A,ws,")".
482println_(php,_,A) -->
483 "echo",ws,"(",!,ws,A,ws,")".
484println_('c++',_,A) -->
485 "cout",ws,"<<",ws,A,ws,"<<",ws,"endl".
486println_('c',number,A) -->
487 "printf",ws,"(",!,ws,"\"%.6f\"",ws,",",!,ws,A,ws,")".
488println_('rust',_,A) -->
489 ("println!(",ws,A,ws,")").
490
491substring_(python,Str,A,B) -->
492 Str,python_ws,"[",python_ws,A,":",python_ws,B,python_ws,"]",!.
493substring_(Lang,A,B,C) -->
494 {memberchk(Lang,['javascript','coffeescript','typescript','java','scala','dart'])},
495 (A,ws,".",ws,"substring",ws,"(",!,ws,B,ws,",",!,ws,C,ws,")"),!.
496substring_(haxe,A,B,C) -->
497 (A,ws,".",ws,"substr",ws,"(",!,ws,B,ws,",",!,ws,C,ws,")"),!.
498substring_('c#',A,B,C) -->
499 (A,ws,".",ws,"Substring",ws,"(",!,ws,B,ws,",",!,ws,C,ws,")"),!.
500substring_(Lang,A,B,C) -->
501 {memberchk(Lang,['php','awk','perl','hack'])},
502 ("substr",ws,"(",!,ws,A,ws,",",!,ws,B,ws,",",!,ws,C,ws,")"),!.
503substring_(lua,A,B,C) -->
504 ("string.sub",ws,"(",!,ws,A,ws,",",!,ws,B,ws,"+",ws,"1",ws,",",!,ws,C,ws,"+",ws,"1",ws,")"),!.
505substring_('c++',A,B,C) -->
506 (A,ws,".",ws,"substring",ws,"(",!,ws,B,ws,",",!,ws,C,ws,"-",ws,B,ws,")"),!.
507set_array_size_('c#',Type,Name,Size) -->
508 set_array_size_(java,Type,Name,Size).
509set_array_size_('go',Type,Name,Size) -->
510 ("var",ws_,Name,ws_,"[",ws,Size,ws,"]",ws,Type).
511
512set_array_size_(java,Type,Name,Size) -->
513 (Type,ws,"[]",ws_,Name,ws,"=",ws,"new",ws_,Type,ws,"[",ws,Size,ws,"]").
514
515set_array_size_(c,Type,Name,Size) -->
516 517 (Type,ws_,Name,ws,"[",ws,Size,ws,"]").
518
519set_array_size_(minizinc,Type,Name,Size) -->
520 ("array",ws,"[",ws,"1",ws,"..",ws,Size,ws,"]",ws_,"of",ws_,Type,ws,":",ws,Name,ws,";").
521
522this_(perl,A) -->
523 ("$self",ws,"->",ws,A).
524this_('ruby',A) -->
525 ("@",A).
526this_(php,A) -->
527 ("$",ws,"this",ws,"->",ws,A).
528this_(python,A) -->
529 ("self",python_ws,".",python_ws,A).
530this_(php,A) -->
531 ("$",ws,"this",ws,"->",ws,A).
532this_(javascript,A) -->
533 534 ("this",python_ws,".",python_ws,A).
535
536class_('perl',Indent,Name,Body) -->
537 ("package",ws_,Name,";",ws,Body).
538class_('ruby',Indent,Name,Body) -->
539 ("class",ws_,Name,ws_,Body,(Indent;ws_),"end").
540class_('c#',Indent,Name,Body) -->
541 class_(java,Indent,Name,Body).
542class_('c++',Indent,Name,Body) -->
543 ("class",ws_,Name,ws,"{",!,ws,Body,(Indent;ws),"}",ws,";"),!.
544class_(java,Indent,Name,Body) -->
545 ("public",ws_,"class",ws_,Name,ws,"{",ws,Body,(Indent;ws),"}"),!.
546class_(python,Indent,Name,Body) -->
547 ("class",python_ws_,Name,":",Body).
548class_(Lang,Indent,Name,Body) -->
549 {memberchk(Lang,['javascript','hack','php','scala','haxe','chapel','swift','d','typescript','dart','perl 6'])},
550 ("class",ws_,Name,ws,"{",!,ws,Body,(Indent;ws),"}"),!.
551
552instance_method_('haxe',Name,Type,Params,Body,Indent) -->
553 ("public",ws_,"function",ws_,Name,ws,"(",!,ws,Params,ws,")",!,ws,":",ws,Type,ws,"{",!,ws,Body,(Indent;ws),"}"),!.
554instance_method_('perl',Name,Type,Params,Body,Indent) -->
555 ("sub",ws_,Name,ws,"{",ws,"my",ws,"(",Params,")",!,ws,"=@_",ws,";",ws,Body,(Indent;ws),"}"),!.
556instance_method_('ruby',Name,Type,Params,Body,Indent) -->
557 ("def",ws_,Name,ws,"(",!,ws,Params,ws,")",!,ws_,Body,(Indent;ws_),"end").
558instance_method_(php,Name,Type,Params,Body,Indent) -->
559 ("public",ws_,"function",ws_,Name,ws,"(",!,ws,Params,ws,")",!,ws,"{",ws,Body,(Indent;ws),"}"),!.
560instance_method_(python,Name,Type,Params,Body,Indent) -->
561 ("def",python_ws_,Name,"(",!,python_ws,"self",python_ws,",",Params,")",":",python_ws,Body).
562instance_method_('c#',Name,Type,Params,Body,Indent) -->
563 instance_method_(java,Name,Type,Params,Body,Indent).
564instance_method_(java,Name,Type,Params,Body,Indent) -->
565 ("public",ws_,Type,ws_,Name,ws,"(",!,ws,Params,ws,")",!,ws,"{",ws,Body,(Indent;ws),"}"),!.
566instance_method_(javascript,Name,Type,Params,Body,Indent) -->
567 (Name,ws,"(",!,ws,Params,ws,")",!,ws,"{",ws,Body,(Indent;ws),"}"),!.
568instance_method_(javascript,Name,Type,Params,Body,Indent) -->
569 {memberchk(Lang,['c++','d','dart'])},
570 (Type,ws_,Name,ws,"(",!,ws,Params,ws,")",!,ws,"{",ws,Body,(Indent;ws),"}"),!.
571
572static_method_(haxe,Name,Type,Params,Body,Indent) -->
573 ("public",ws_,"static",ws_,"function",ws_,Name,ws,"(",!,ws,Params,ws,")",!,ws,"{",ws,Body,(Indent;ws),"}"),!.
574static_method_(perl,Name,Type,Params,Body,Indent) -->
575 ("sub",ws_,Name,ws,"{",ws,"my",ws,"(",Params,")",ws,"=@_",ws,";",ws,Body,(Indent;ws),"}"),!.
576static_method_(ruby,Name,Type,Params,Body,Indent) -->
577 ("def",ws_,"self.",Name,ws,"(",!,ws,Params,ws,")",!,ws_,Body,(Indent;ws_),"end").
578static_method_(php,Name,Type,Params,Body,Indent) -->
579 ("public",ws_,"static",ws_,"function",ws_,Name,ws,"(",!,ws,Params,ws,")",!,ws,"{",ws,Body,(Indent;ws),"}"),!.
580static_method_(javascript,Name,Type,Params,Body,Indent) -->
581 ("static",ws_,Name,ws,"(",!,ws,Params,ws,")",!,ws,"{",ws,Body,(Indent;ws),"}"),!.
582static_method_('c#',Name,Type,Params,Body,Indent) --> static_method_(java,Name,Type,Params,Body,Indent).
583static_method_(java,Name,Type,Params,Body,Indent) -->
584 ("public",ws_,"static",ws_,Type,ws_,Name,ws,"(",!,ws,Params,ws,")",!,ws,"{",ws,Body,(Indent;ws),"}"),!.
585static_method_(python,Name,Type,Params,Body,Indent) -->
586 ("@staticmethod",Indent,"def",python_ws_,Name,python_ws,"(",!,python_ws,Params,python_ws,")",":",python_ws,Body).
587static_method_(Lang,Name,Type,Params,Body,Indent) -->
588 {memberchk(Lang,['c++','d','dart'])},
589 ("static",ws_,Type,ws_,Name,ws,"(",!,ws,Params,ws,")",!,ws,"{",ws,Body,(Indent;ws),"}"),!.
590
591constructor_(haxe,Name,Params,Body,Indent) -->
592 ("public",ws_,"function",ws_,"new",ws,"(",!,ws,Params,ws,")",!,ws,"{",ws,Body,(Indent;ws),"}"),!.
593constructor_(perl,Name,Params,Body,Indent) -->
594 ("sub",ws_,"new",ws,"{",ws,"my($class,",Params,") = @_;my $s = {};bless $s, $class;",Body,"return $s;",(Indent;ws),"}"),!.
595constructor_(ruby,Name,Params,Body,Indent) -->
596 ("def",ws_,"initialize",ws,"(",!,ws,Params,ws,")",!,ws_,Body,(Indent;ws_),"end").
597constructor_(php,Name,Params,Body,Indent) -->
598 ("function",ws_,"__construct",ws,"(",!,ws,Params,ws,")",!,ws,"{",ws,Body,(Indent;ws),"}"),!.
599constructor_(d,Name,Params,Body,Indent) -->
600 601 (Name,ws,"(",!,ws,Params,ws,")",!,ws,"{",!,ws,Body,(Indent;ws),"}"),!.
602constructor_(java,Name,Params,Body,Indent) -->
603 604 ("public",ws_,Name,ws,"(",!,ws,Params,ws,")",!,ws,"{",!,ws,Body,(Indent;ws),"}"),!.
605constructor_(javascript,Name,Params,Body,Indent) -->
606 ("constructor",ws,"(",!,ws,Params,ws,")",!,ws,"{",!,ws,Body,(Indent;ws),"}"),!.
607constructor_(python,Name,Params,Body,Indent) -->
608 ("def",python_ws_,"__init__",python_ws,"(",!,python_ws,"self",python_ws,",",python_ws,Params,python_ws,")",":",!,python_ws,Body).
609
610strip_(Lang,Str) -->
611 {memberchk(Lang,[java,javascript])},
612 (Str,ws,".",ws,"trim",ws,"(",!,ws,")"),!.
613
614strip_(python,Str) -->
615 (Str,python_ws,".",python_ws,"strip",python_ws,"(",!,python_ws,")").
616
617lstrip_(python,Str) -->
618 (Str,python_ws,".",python_ws,"lstrip",python_ws,"(",!,python_ws,")").
619lstrip_('ruby',Str) -->
620 (Str,ws,".",ws,"lstrip").
621lstrip_('java',Str) -->
622 Str,".replaceAll(\"^\\s+\", \"\")".
623lstrip_('javascript',Str) -->
624 (Str,ws,".replace(/^\s+/,'')").
625lstrip_('php',Str) -->
626 ("ltrim",ws,"(",!,ws,Str,ws,")").
627lstrip_('c#',Str) -->
628 (Str,ws,".",ws,"TrimStart",ws,"(",!,ws,")").
629
630rstrip_('php',Str) -->
631 ("rtrim",ws,"(",!,ws,Str,ws,")").
632rstrip_('java',Str) -->
633 (Str,ws,".replaceAll(\"\\s+$\",\"\")").
634rstrip_(python,Str) -->
635 (Str,python_ws,".",python_ws,"rstrip",python_ws,"(",!,python_ws,")",!).
636rstrip_(javascript,Str) -->
637 (Str,ws,".replace(/\s+$/,'')").
638rstrip_('c#',Str) -->
639 (Str,ws,".",ws,"TrimEnd",ws,"(",!,ws,")").
640rstrip_('ruby',Str) -->
641 (Str,ws,".",ws,"rstrip").
642
643type_conversion_(javascript,number,string,A) --> "toString",ws,"(",!,ws,A,ws,")",!.
644type_conversion_(python,_,To,A) --> type(python,To),python_ws,"(",!,python_ws,A,python_ws,")",!.
645type_conversion_(swift,_,To,A) --> type(swift,To),ws,"(",!,ws,A,ws,")",!.
646type_conversion_(python,_,To,A) --> type(python,To),ws,"(",!,ws,A,ws,")",!.
647type_conversion_(ruby,string,int,A) --> A,ws,".",ws,"to_i".
648type_conversion_(ruby,int,string,A) --> A,ws,".",ws,"to_s".
649type_conversion_('c++',int,string,Arg) -->
650 ("std::to_string",ws,"(",!,ws,Arg,ws,")").
651type_conversion_(ruby,number,string,A) --> A,ws,".",ws,"to_s".
652type_conversion_('c#',_,string,A) --> "Convert",ws,".",ws,"ToString",ws,"(",!,ws,A,ws,")",!.
653type_conversion_('c#',_,int,A) --> "Convert",ws,".",ws,"ToInt32",ws,"(",!,ws,A,ws,")",!.
654type_conversion_('java',string,int,A) --> "Integer",ws,".",ws,"parseInt",ws,"(",!,ws,A,ws,")",!.
655type_conversion_('java',string,number,A) --> "Double",ws,".",ws,"parseDouble",ws,"(",!,ws,A,ws,")",!.
656type_conversion_('java',int,string,A) -->
657 "Integer",ws,".",ws,"toString",ws,"(",!,ws,A,ws,")";
658 "String",ws,".",ws,"valueOf",ws,"(",!,ws,A,ws,")",!.
659type_conversion_('lua',number,string,A) -->
660 "tostring",ws,"(",!,ws,A,ws,")",!.
661type_conversion_('lua',int,string,A) -->
662 "tostring",ws,"(",!,ws,A,ws,")",!.
663type_conversion_('java',int,double,A) -->
664 "(double)",A.
665type_conversion_('c',int,double,A) -->
666 "(double)",A.
667type_conversion_('java',number,string,A) -->
668 "Double",ws,".",ws,"toString",ws,"(",!,ws,A,ws,")";
669 "String",ws,".",ws,"valueOf",ws,"(",!,ws,A,ws,")".
670type_conversion_('javascript',string,int,A) --> ("parseInt",ws,"(",!,ws,A,ws,")").
671type_conversion_('javascript',string,number,A) --> ("Number",ws,"(",!,ws,A,ws,")").
672type_conversion_('lua',string,number,A) --> ("tonumber",ws,"(",!,ws,A,ws,")").
673type_conversion_('lua',string,int,A) --> ("tonumber",ws,"(",!,ws,A,ws,")").
674type_conversion_('perl',string,number,A) --> A.
675type_conversion_('perl',number,string,A) --> A.
676type_conversion_(c,string,int,A) -->
677 "(",ws,"int",ws,")",ws_,"strtol",ws,"(",ws,A,ws,",",ws,"(",ws,"char",ws_,"**",ws,")",ws,"NULL,",ws,"10",ws,")";
678 "atoi",ws,"(",!,ws,A,ws,")".
679
680pow_(lua,A,B) -->
681 "(",ws,A,ws,")",ws,"^",!,ws,"(",ws,B,ws,")".
682pow_(python,A,B) -->
683 "(",python_ws,A,python_ws,")",python_ws,"**",python_ws,"(",python_ws,B,python_ws,")".
684pow_(ruby,A,B) --> pow_(python,A,B).
685pow_('c#',A,B) -->
686 ("Math",ws,".",ws,"Pow",ws,"(",!,ws,A,ws,",",!,ws,B,ws,")"),!.
687pow_(javascript,A,B) --> pow_(java,A,B).
688pow_(java,A,B) -->
689 ("Math",ws,".",ws,"pow",ws,"(",!,ws,A,ws,",",!,ws,B,ws,")"),!.
690pow_(haxe,A,B) -->pow_(java,A,B).
691pow_(erlang,A,B) -->
692 ("math",ws,":",ws,"pow",ws,"(",!,ws,A,ws,",",!,ws,B,ws,")"),!.
693pow_(c,A,B) -->
694 "pow",ws,"(",!,ws,A,ws,",",!,ws,B,ws,")",!.
695pow_('c++',A,B) --> pow_(c,A,B).
696pow_('perl',A,B) --> pow_(c,A,B).
697pow_(php,A,B) --> pow_(c,A,B).
698
699abs_(prolog,Type,A) --> abs_(python,Type,A).
700abs_(erlang,Type,A) --> abs_(python,Type,A).
701abs_(c,int,A) --> abs_(python,Type,A).
702abs_(php,Type,A) --> abs_(python,Type,A).
703abs_(c,number,A) --> "fabs",ws,"(",!,ws,A,ws,")",!.
704abs_('c++',Type,A) --> abs_(python,Type,A).
705abs_(perl,Type,A) --> abs_(python,Type,A).
706abs_(python,_,A) -->
707 "abs",python_ws,"(",!,python_ws,A,python_ws,")",!.
708abs_(javascript,Type,A) --> abs_(java,Type,A).
709abs_(java,_,A) -->
710 "Math",ws,".",ws,"abs",ws,"(",!,ws,A,ws,")",!.
711abs_('c#',_,A) -->
712 "Math",ws,".",ws,"Abs",ws,"(",!,ws,A,ws,")",!.
713abs_('f#',_,A) --> abs_('c#',A).
714abs_(ruby,_,A) --> A,".abs".
715
716sin_('c#',A) -->
717 "Math",ws,".",ws,"Sin",ws,"(",!,ws,A,ws,")",!.
718sin_(ruby,A) --> sin_(java,A).
719sin_(javascript,A) --> sin_(java,A).
720sin_(haxe,A) --> sin_(java,A).
721sin_(java,A) -->
722 "Math",ws,".",ws,"sin",ws,"(",!,ws,A,ws,")",!.
723sin_(perl,A) -->
724 sin_(c,A).
725sin_(php,A) -->
726 sin_(c,A).
727sin_('c++',A) -->
728 sin_(c,A).
729sin_(c,A) -->
730 "sin",ws,"(",!,ws,A,ws,")",!.
731sin_(lua,A) --> sin_(python,A).
732sin_(python,A) -->
733 "math",ws,".",ws,"sin",ws,"(",!,ws,A,ws,")",!.
734
735asin_('c++',A) --> asin_(c,A).
736asin_(perl,A) --> asin_(c,A).
737asin_(php,A) --> asin_(c,A).
738asin_(c,A) -->
739 "asin",ws,"(",!,ws,A,ws,")",!.
740asin_('ruby',A) -->
741 asin_('java',A).
742asin_('javascript',A) -->
743 asin_('java',A).
744asin_('java',A) -->
745 "Math",ws,".",ws,"asin",ws,"(",!,ws,A,ws,")",!.
746asin_('haxe',A) -->
747 asin_('java',A).
748asin_('c#',A) -->
749 "Math",ws,".",ws,"Asin",ws,"(",!,ws,A,ws,")",!.
750asin_(lua,A) --> asin_(python,A).
751asin_(python,A) -->
752 "math",python_ws,".",python_ws,"asin",python_ws,"(",!,python_ws,A,python_ws,")",!.
753
754
755acos_(python,A) -->
756 "math",python_ws,".",python_ws,"acos",python_ws,"(",!,python_ws,A,python_ws,")",!.
757acos_(perl,A) --> acos_(c,A).
758acos_(php,A) --> acos_(c,A).
759acos_('c++',A) --> acos_(c,A).
760acos_(c,A) -->
761 "acos",ws,"(",!,ws,A,ws,")",!.
762acos_(lua,A) --> acos_(python,A).
763acos_(python,A) -->
764 "math",python_ws,".",python_ws,"acos",python_ws,"(",!,python_ws,A,python_ws,")",!.
765acos_('c#',A) -->
766 "Math",ws,".",ws,"Acos",ws,"(",!,ws,A,ws,")",!.
767acos_(ruby,A) --> acos_(java,A),!.
768acos_(javascript,A) --> acos_(java,A),!.
769acos_(java,A) -->
770 "Math",ws,".",ws,"acos",ws,"(",!,ws,A,ws,")",!.
771acos_(haxe,A) --> acos_(java,A).
772
773
774sqrt_(python,A) -->
775 "math",python_ws,".",python_ws,"sqrt",python_ws,"(",!,python_ws,A,python_ws,")",!.
776sqrt_(c,A) -->
777 "sqrt",ws,"(",!,ws,A,ws,")",!.
778 779sqrt_('c++',A) --> sqrt_(c,A).
780sqrt_('perl',A) --> sqrt_(c,A).
781sqrt_('php',A) --> sqrt_(c,A).
782sqrt_('swift',A) --> sqrt_(c,A).
783sqrt_('prolog',A) --> sqrt_(c,A).
784sqrt_('octave',A) --> sqrt_(c,A).
785sqrt_('d',A) --> sqrt_(c,A).
786sqrt_(lua,A) -->
787 "math",ws,".",ws,"sqrt",ws,"(",!,ws,A,ws,")",!.
788sqrt_(go,A) -->
789 "math",ws,".",ws,"Sqrt",ws,"(",!,ws,A,ws,")",!.
790sqrt_(javascript,A) --> sqrt_(java,A),!.
791sqrt_(haxe,A) --> sqrt_(java,A),!.
792sqrt_(ruby,A) --> sqrt_(java,A),!.
793sqrt_(java,A) -->
794 "Math",ws,".",ws,"sqrt",ws,"(",!,ws,A,ws,")",!.
795sqrt_('c#',A) -->
796 ("Math",ws,".",ws,"Sqrt",ws,"(",!,ws,A,ws,")").
797
798asin_(haxe,A) --> asin_(java,A).
799asin_(ruby,A) --> asin_(java,A).
800asin_(javascript,A) --> asin_(java,A).
801asin_(java,A) -->
802 "Math",ws,".",ws,"asin",ws,"(",!,ws,A,ws,")",!.
803asin_(c,A) -->
804 "asin",ws,"(",!,ws,A,ws,")",!.
805asin_(php,A) --> asin_(c,A).
806asin_(perl,A) --> asin_(c,A).
807
808
809cos_(ruby,A) --> cos_(java,A).
810cos_(haxe,A) --> cos_(java,A).
811cos_(javascript,A) --> cos_(java,A).
812cos_('c#',A) -->
813 "Math",ws,".",ws,"Cos",ws,"(",!,ws,A,ws,")",!.
814cos_(java,A) -->
815 "Math",ws,".",ws,"cos",ws,"(",!,ws,A,ws,")",!.
816cos_(c,A) -->
817 "cos",ws,"(",!,ws,A,ws,")",!.
818cos_(lua,A) --> cos_(python,A).
819cos_(python,A) -->
820 "math",python_ws,".",python_ws,"cos",python_ws,"(",!,python_ws,A,python_ws,")",!.
821cos_(php,A) -->
822 cos_(c,A).
823cos_(perl,A) -->
824 cos_(c,A).
825cos_('c++',A) -->
826 cos_(c,A).
827
828tan_(ruby,A) --> tan_(java,A),!.
829tan_(javascript,A) --> tan_(java,A),!.
830tan_('perl',A) --> tan_('c',A),!.
831tan_('php',A) --> tan_('c',A),!.
832tan_('c',A) -->
833 "tan",ws,"(",!,ws,A,ws,")",!.
834tan_('c#',A) -->
835 "Math",ws,".",ws,"Tan",ws,"(",!,ws,A,ws,")",!.
836tan_(lua,A) --> tan_(python,A).
837tan_(python,A) -->
838 "math",python_ws,".",python_ws,"tan",python_ws,"(",!,python_ws,A,python_ws,")",!.
839tan_(java,A) -->
840 "Math",ws,".",ws,"tan",ws,"(",!,ws,A,ws,")",!.
841tan_(haxe,A) --> tan_(java,A).
842
843atan_('c#',A) -->
844 "Math",ws,".",ws,"Atan",!,ws,"(",!,ws,A,ws,")",!.
845atan_(ruby,A) --> atan_(java,A),!.
846atan_(javascript,A) --> atan_(java,A),!.
847atan_(java,A) -->
848 "Math",ws,".",ws,"atan",ws,"(",!,ws,A,ws,")",!.
849atan_(javascript,A) --> atan_(java,A),!.
850atan_('c++',A) --> atan_(c,A),!.
851atan_(php,A) --> atan_(c,A),!.
852atan_(perl,A) --> atan_(c,A),!.
853atan_(c,A) -->
854 "atan",ws,"(",!,ws,A,ws,")",!.
855atan_(lua,A) --> atan_(python,A),!.
856atan_(python,A) -->
857 "math",python_ws,".",python_ws,"atan",python_ws,"(",!,python_ws,A,python_ws,")",!.
858atan_(haxe,A) --> atan_(java,A),!.
859
860
861initializer_list_(python,_,A) --> "[",python_ws,A,python_ws,"]",!.
862initializer_list_(javascript,_,A) --> "[",ws,!,A,ws,"]",!.
863initializer_list_(ruby,_,A) --> "[",!,ws,A,ws,"]",!.
864initializer_list_(prolog,_,A) --> "[",!,ws,A,ws,"]",!.
865initializer_list_(haxe,_,A) --> "[",!,ws,A,ws,"]",!.
866initializer_list_(swift,_,A) --> "[",!,ws,A,ws,"]",!.
867initializer_list_('c#',_,A) --> "{",!,ws,A,ws,"}",!.
868initializer_list_('c++',_,A) --> "{",ws,A,ws,"}".
869initializer_list_('c',_,A) --> "{",ws,A,ws,"}".
870initializer_list_('lua',_,A) --> "{",ws,A,ws,"}".
871initializer_list_(java,Type,A) --> "new",ws_,Type,ws,"[]",ws,"{",python_ws,A,python_ws,"}".
872initializer_list_(perl,_,A) --> "(",!,python_ws,A,python_ws,")".
873initializer_list_(php,_,A) --> ("array",ws,"(",ws,A,ws,")";"[",ws,A,ws,"]").
874
876length_(rust,_,A) -->
877 (A,ws,".",ws,"len",ws,"(",!,ws,")").
878
879length_(lua,string,A) --> "string",ws,".",ws,"len",ws,"(",!,ws,A,ws,")",!.
880length_(lua,[array,_],A) --> "#",A.
881
882length_(python,_,A) --> "len",python_ws,"(",!,python_ws,A,python_ws,")",!.
883length_(javascript,_,A) --> A,".",ws,"length".
884length_(perl,[array,_],A) --> ("scalar",ws,"(",ws,A,ws,")").
885length_(ruby,_,A) --> A,".",ws,("size";"length").
886length_(java,[array,_],A) --> A,".",ws,"length".
887length_(java,string,A) --> A,".",ws,"length",ws,"(",ws,")",!.
888length_(c,string,A) --> "strlen",ws,"(",!,ws,A,ws,")",!.
889length_(php,[array,_],A) --> "sizeof",ws,"(",!,ws,A,ws,")",!.
890length_(php,string,A) --> length_(c,string,A).
891length_(swift,[array,_],A) --> A,ws,".",ws,"count".
892length_(c,[array,_],A) --> ("sizeof",ws,"(",ws,A,ws,")",ws,"/",ws,"sizeof",ws,"(",ws,A,ws,"[",ws,"0",ws,"]",ws,")").
893
895length_('c#',_,A) -->
896 A,ws,".",ws,"Length".
897
898not_equals_(c,string,A,B) --> "(",ws,"strcmp",ws,"(",ws,A,ws,",",ws,B,ws,")",ws,"!=",ws,"0",ws,")",!.
899not_equals_(python,_,A,B) --> A,python_ws,"!=",!,python_ws,B.
900not_equals_(ruby,_,A,B) --> A,ws,"!=",!,ws,B.
901not_equals_(c,number,A,B) --> A,ws,"!=",!,ws,B.
902not_equals_(perl,number,A,B) --> A,ws,"!=",!,ws,B.
903not_equals_('c++',string,A,B) --> A,ws,"!=",!,ws,B.
904not_equals_('c#',string,A,B) --> A,ws,"!=",!,ws,B.
905not_equals_(lua,Type,A,B) --> {member(Type,[int,number,string,bool])},A,ws,"~=",ws,B.
906not_equals_(perl,string,A,B) --> A,ws_,"ne",ws_,B.
907not_equals_(javascript,_,A,B) -->
908 A,ws,"!==",!,
909 910 ws,B.
911not_equals_(php,Type,A,B) --> A,ws,"!==",!,ws,B,{member(Type,[string,number,int,char])}.
912not_equals_(c,string,A,B) --> "(",ws,"strcmp",ws,"(",ws,A,ws,",",ws,B,ws,")",ws,"!=",ws,"0",ws,")",!.
913not_equals_(java,char,A,B) --> not_equals_(c,number,A,B).
914not_equals_(java,number,A,B) --> not_equals_(c,number,A,B).
915not_equals_(java,string,A,B) --> "!",ws,equals_(java,string,A,B).
916not_equals_('c++',number,A,B) --> not_equals_(c,number,A,B).
917not_equals_(java,number,A,B) --> not_equals_(c,int,A,B).
918not_equals_('c#',number,A,B) --> not_equals_(c,int,A,B).
919not_equals_('haxe',Type,A,B) --> {member(Type,[int,number,string,bool])},not_equals_(c,int,A,B).
920not_equals_(Lang,int,A,B) --> not_equals_(Lang,number,A,B).
921
922equals_('c#',[array,_],A,B) --> A,ws,".",ws,"SequenceEqual",ws,"(",!,ws,B,ws,")",!.
923equals_(java,[array,_],A,B) --> "Arrays",ws,".",ws,"equals",ws,"(",!,ws,A,ws,",",!,ws,B,ws,")",!.
924equals_(erlang,_,A,B) --> A,ws,"===",ws,B.
925equals_(python,_,A,B) --> A,python_ws,"==",python_ws,B.
926equals_(sympy,_,A,B) --> "Eq",python_ws,"(",A,python_ws,",",python_ws,B,python_ws,")",!.
927equals_(javascript,Type,A,B) --> A,ws,"===",!,ws,B.
928equals_(php,Type,A,B) --> {member(Type,[bool,number,int,string,char,[array,_]])},A,ws,"===",!,ws,B.
929equals_(c,Type,A,B) --> {member(Type,[bool,number,int,char])},A,ws,"==",!,ws,B.
930equals_(c,string,A,B) --> "(",ws,"strcmp",ws,"(",ws,A,ws,",",ws,B,ws,")",ws,"==",!,ws,"0",ws,")",!.
931equals_(sympy,A,B) --> "Eq",python_ws,"(",!,python_ws,A,python_ws,",",python_ws,B,python_ws,")",!.
932equals_(java,bool,A,B) --> A,ws,"==",!,ws,B.
933equals_(java,number,A,B) --> A,ws,"==",!,ws,B.
934equals_(java,char,A,B) --> A,ws,"==",!,ws,B.
935equals_(java,string,A,B) --> A,ws,".",ws,"equals",ws,"(",!,ws,B,ws,")",!.
936equals_('c#',number,A,B) --> A,ws,"==",!,ws,B.
937equals_('c#',string,A,B) --> A,ws,"==",!,ws,B.
938equals_('c++',string,A,B) --> A,ws,"==",!,ws,B.
939equals_('haxe',string,A,B) --> A,ws,"==",!,ws,B.
940equals_(lua,number,A,B) --> A,python_ws,"==",!,python_ws,B.
941equals_(lua,bool,A,B) --> A,ws,"==",!,ws,B.
942equals_(lua,string,A,B) --> A,ws,"==",!,ws,B.
943equals_(lua,char,A,B) --> A,ws,"==",!,ws,B.
944equals_(ruby,_,A,B) --> A,ws,"==",ws,B.
945equals_(perl,string,A,B) --> A,ws_,"eq",ws_,B.
946equals_(Lang,int,A,B) --> equals_(Lang,number,A,B).
947
948access_array_(Lang,Array,Index) --> access_array_(Lang,_,Array,Index).
949
951access_array_('ruby',_,Array,Index) --> access_array_(c,Array,Index).
952access_array_('php',_,Array,Index) --> access_array_(c,Array,Index).
953access_array_('python',_,Array,Index) --> access_array_(c,Array,Index).
954access_array_('c',_,Array,Index) --> Array,ws,"[",!,ws,Index,ws,"]",!.
955access_array_('c#',_,Array,Index) --> access_array_(c,Array,Index).
956access_array_('lua',_,Array,Index) --> Array,ws,"[",ws,Index,ws,"+",ws,"1",ws,"]",!.
957
958access_array_('minizinc',[array,_],Array,Index) --> access_array_(c,Array,Index).
959access_array_('perl',[array,_],Array,Index) --> access_array_(c,Array,Index).
960access_array_('dart',[array,_],Array,Index) --> access_array_(c,Array,Index).
961access_array_('ruby',[array,_],Array,Index) --> access_array_(c,Array,Index).
962access_array_('c++',[array,_],Array,Index) --> access_array_(c,Array,Index).
963access_array_('javascript',string,Array,Index) --> Array,ws,".",ws,"charAt",ws,"(",!,ws,Index,ws,")",!.
964access_array_('javascript',_,Array,Index) --> access_array_(c,Array,Index).
965access_array_('haxe',[array,_],Array,Index) --> access_array_(c,Array,Index).
966access_array_('c++',[array,_],Array,Index) --> access_array_(c,Array,Index).
967access_array_('java',string,Array,Index) --> Array,ws,".",ws,"charAt",ws,"(",!,ws,Index,ws,")",!.
968access_array_('java',[array,_],Array,Index) --> access_array_(c,Array,Index).
969
970
971set_array_index(ruby,A,B,C) --> set_array_index(python,A,B,C).
972set_array_index(lua,A,B,C) --> set_array_index(python,A,B,C).
973set_array_index('perl',A,B,C) --> set_array_index(python,A,B,C).
974set_array_index('c#',A,B,C) --> set_array_index(python,A,B,C).
975set_array_index('c++',A,B,C) --> set_array_index(python,A,B,C).
976set_array_index(java,A,B,C) --> set_array_index(python,A,B,C).
977set_array_index(python,A,B,C) -->
978 A,python_ws,"[",python_ws,B,python_ws,"]",python_ws,"=",python_ws,C.
979
980or_(python,A,B) --> A,python_ws_,"or",python_ws_,B.
981or_(ruby,A,B) --> A,python_ws_,"or",python_ws_,B.
982or_(lua,A,B) --> A,python_ws_,"or",python_ws_,B.
983or_(c,A,B) --> A,ws,"||",!,{writeln('calling or_')},ws,B.
984or_(prolog,A,B) --> A,python_ws,";",!,python_ws,B.
985or_('haxe',A,B) --> or_(c,A,B).
986or_(java,A,B) --> or_(c,A,B).
987or_('c#',A,B) --> or_(c,A,B).
988or_('c++',A,B) --> or_(c,A,B).
989or_(javascript,A,B) --> or_(c,A,B).
990or_(perl,A,B) --> or_(c,A,B).
991or_(php,A,B) --> or_(c,A,B).
992
993
994and_(c,A,B) --> A,ws,"&&",!,{writeln('calling and_')},ws,B.
995and_(java,A,B) --> and_(c,A,B).
996and_(javascript,A,B) --> and_(c,A,B).
997and_(haxe,A,B) --> and_(c,A,B).
998and_('c++',A,B) --> and_(c,A,B).
999and_('php',A,B) --> and_(c,A,B).
1000and_('perl',A,B) --> and_(c,A,B).
1001and_('c#',A,B) --> and_(c,A,B).
1002and_(ruby,A,B) --> A,python_ws_,"and",python_ws_,B.
1003and_(lua,A,B) --> A,python_ws_,"and",python_ws_,B.
1004and_(python,A,B) --> A,python_ws_,"and",python_ws_,B.
1005
1006add_(php,[array,_],A,B) -->
1007 ("array_merge",ws,"(",!,ws,A,ws,",",!,ws,B,ws,")").
1008add_(python,_,A,B) -->
1009 A,python_ws,"+",python_ws,B.
1010add_('javascript',Type,A,B) -->
1011 1012 A,ws,"+",!,ws,B.
1013add_('prolog',number,A,B) -->
1014 A,ws,"+",!,ws,B.
1015add_('minizinc',number,A,B) -->
1016 A,ws,"+",!,ws,B.
1017add_('rust',number,A,B) -->
1018 A,ws,"+",!,ws,B.
1019add_('c++',Type,A,B) -->
1020 {member(Type,[string,number])},A,ws,"+",!,ws,B.
1021add_('java',Type,A,B) -->
1022 {member(Type,[string,number])},A,ws,"+",!,ws,B.
1023add_('c#',Type,A,B) -->
1024 {member(Type,[string,number])},A,ws,"+",!,ws,B.
1025add_('perl',number,A,B) -->
1026 A,ws,"+",!,ws,B.
1027add_('perl',string,A,B) -->
1028 A,ws,".",ws,B.
1029add_('php',string,A,B) -->
1030 A,ws,".",ws,B.
1031add_('php',number,A,B) -->
1032 A,ws,"+",!,ws,B.
1033add_('ruby',Type,A,B) -->
1034 1035 A,ws,!,"+",ws,B.
1036add_('haskell',string,A,B) -->
1037 A,ws,"++",ws,B.
1038add_('haskell',number,A,B) -->
1039 A,ws,"+",ws,B.
1040add_('lua',string,A,B) -->
1041 A,ws,"..",!,ws,B.
1042add_('lua',number,A,B) -->
1043 A,ws,"+",!,ws,B.
1044add_('haxe',Type,A,B) -->
1045 1046 A,ws,"+",!,ws,B.
1047add_('c',number,A,B) -->
1048 A,ws,"+",!,ws,B.
1049add_('erlang',number,A,B) -->
1050 A,ws,"+",!,ws,B.
1051add_(Lang,int,A,B) -->
1052 add_(Lang,number,A,B).
1053
1054else_(python,Indent,B) -->
1055 "else:",!,python_ws,B,(Indent;ws).
1056else_(perl,Indent,B) --> else_(c,Indent,B).
1057else_(php,Indent,B) --> else_(c,Indent,B).
1058else_('c++',Indent,B) --> else_(c,Indent,B).
1059else_(haxe,Indent,B) --> else_(c,Indent,B).
1060else_(java,Indent,B) --> else_(c,Indent,B).
1061else_(javascript,Indent,B) --> else_(c,Indent,B).
1062else_('c#',Indent,B) --> else_(c,Indent,B).
1063else_('d',Indent,B) --> else_(c,Indent,B).
1064else_(c,Indent,B) -->
1065 "else",ws,"{",!,ws,B,(Indent;ws),"}",!.
1066else_(lua,Indent,B) -->
1067 "else",ws_,B,(Indent;ws_),"end".
1068else_(ruby,Indent,B) --> else_(lua,Indent,B).
1069
1070elif_(python,Indent,[A,B]) -->
1071 "elif",indented_block(A),!,python_ws,B.
1072elif_(lua,Indent,[A,B]) -->
1073 ("elseif",ws_,A,ws_,"then",ws_,B).
1074elif_(ruby,Indent,[A,B]) -->
1075 ("elsif",ws_,A,ws_,B).
1076elif_(java,Indent,[A,B]) --> elif_(c,Indent,[A,B]),!.
1077elif_(php,Indent,[A,B]) --> elif_(c,Indent,[A,B]),!.
1078elif_(javascript,Indent,[A,B]) --> elif_(c,Indent,[A,B]),!.
1079elif_('c++',Indent,[A,B]) --> elif_(c,Indent,[A,B]),!.
1080elif_('c#',Indent,[A,B]) --> elif_(c,Indent,[A,B]),!.
1081elif_('haxe',Indent,[A,B]) --> elif_(c,Indent,[A,B]),!.
1082elif_(c,Indent,[A,B]) -->
1083 "else",ws_,"if",ws,"(",!,ws,A,ws,")",!,ws,"{",!,ws,B,(Indent;ws),"}",!.
1084elif_(perl,Indent,[A,B]) -->
1085 "elsif",ws,"(",!,ws,A,ws,")",!,ws,"{",!,ws,B,(Indent;ws),"}",!.
1086
1087function_(sympy,Indent,Type,Name,Params,Body) -->
1088 function_(python,Indent,Type,Name,Params,Body).
1089function_(python,Indent,_,Name,Params,Body) -->
1090 "def",python_ws_,Name,python_ws,"(",!,python_ws,Params,python_ws,"):",!,python_ws,Body.
1091function_(sympy,Indent,_,Name,Params,Body) -->
1092 function_(python,Indent,Type,Name,Params,Body).
1093function_(perl,Indent,_,Name,Params,Body) -->
1094 "sub",ws_,Name,ws,"{",ws,"my",ws,"(",Params,")",ws,"=@_",ws,";",ws,Body,(Indent;ws),"}",!.
1095function_('haxe',Indent,Type,Name,Params,Body) -->
1096 ("public",ws_,"static",ws_,"function",ws_,Name,ws,"(",!,ws,Params,ws,")",ws,":",ws,Type,ws,"{",ws,Body,(Indent;ws),"}"),!.
1097function_('erlang',Indent,Type,Name,Params,Body) -->
1098 (Name,ws,"(",!,ws,Params,ws,")",ws,"->",ws,Body).
1099function_('php',Indent,Type,Name,Params,Body) --> function_('javascript',Indent,Type,Name,Params,Body).
1100function_('javascript',Indent,_,Name,Params,Body) -->
1101 "function",ws_,Name,ws,"(",!,ws,Params,ws,")",!,ws,"{",!,ws,Body,(Indent;ws),"}",!.
1102function_('c#',Indent,Type,Name,Params,Body) -->
1103 "public",ws_,"static",ws_,Type,ws_,Name,ws,"(",!,ws,Params,ws,")",!,ws,"{",!,ws,Body,(Indent;ws),"}",!.
1104function_('java',Indent,Type,Name,Params,Body) -->
1105 function_('c#',Indent,Type,Name,Params,Body).
1106function_('c++',Indent,Type,Name,Params,Body) -->
1107 Type,ws_,Name,ws,"(",!,ws,Params,ws,")",ws,"{",ws,Body,(Indent;ws),"}",!.
1108function_('prolog',Indent,Type,Name,Params,Body) -->
1109 Name,ws,"(",!,ws,Params,ws,",",!,ws,"Return",ws,")",ws,":-",Body.
1110function_('c',Indent,Type,Name,Params,Body) -->
1111 Type,ws_,Name,ws,"(",!,ws,Params,ws,")",ws,"{",!,ws,Body,(Indent;ws),"}",!.
1112function_('lua',Indent,_,Name,Params,Body) -->
1113 ("function",ws_,Name,ws,"(",!,ws,Params,ws,")",!,ws_,Body,(Indent;ws_),"end"),!.
1114function_('ruby',Indent,_,Name,Params,Body) -->
1115 ("def",ws_,Name,ws,"(",!,ws,Params,ws,")",ws_,Body,(Indent;ws_),"end"),!.
1116
1117sort_in_place_(python,A) -->
1118 A,python_ws,".",python_ws,"sort",python_ws,"(",!,python_ws,")",!.
1119sort_in_place_(ruby,A) -->
1120 A,ws,".",ws,"sort!",!.
1121sort_in_place_(php,A) -->
1122 ("sort",ws,"(",!,ws,A,ws,")").
1123sort_in_place_(lua,A) -->
1124 ("table",ws,".",ws,"sort",ws,"(",!,ws,List,ws,")").
1125sort_in_place_('java',A) -->
1126 "Arrays",ws,".",ws,"sort",ws,"(",!,ws,A,ws,")",!.
1127sort_in_place_('c++',A) -->
1128 ("std::sort",ws,"(",!,ws,"std::begin",ws,"(",!,ws,List,ws,")",ws,",",ws,"std::end",ws,"(",!,ws,List,ws,")",ws,")").
1129
1130reverse_in_place_(python,A) -->
1131 A,python_ws,".",python_ws,"reverse",python_ws,"(",!,python_ws,")",!.
1132reverse_in_place_(javascript,A) --> reverse_in_place_(python,A).
1133reverse_in_place_('c#',A) -->
1134 "Array",ws,".",ws,"Reverse",ws,"(",!,ws,A,ws,")",!.
1135reverse_in_place_('ruby',List) -->
1136 (List,ws,".",ws,"sort!").
1137
1138while_(python,Indent,A,B) -->
1139 "while",indented_block(A),!,python_ws,B.
1140
1141while_(php,Indent,A,B) --> while_(c,Indent,A,B),!.
1142while_(perl,Indent,A,B) --> while_(c,Indent,A,B),!.
1143while_(javascript,Indent,A,B) --> while_(c,Indent,A,B),!.
1144while_('c++',Indent,A,B) --> while_(c,Indent,A,B),!.
1145while_('c#',Indent,A,B) --> while_(c,Indent,A,B),!.
1146while_(java,Indent,A,B) --> while_(c,Indent,A,B),!.
1147while_(haxe,Indent,A,B) --> while_(c,Indent,A,B),!.
1148while_(c,Indent,A,B) -->
1149 "while",ws,"(",!,ws,A,ws,")",ws,"{",!,ws,B,(Indent;ws),"}",!.
1150while_(ruby,Indent,A,B) --> while_(lua,Indent,A,B).
1151while_(lua,Indent,A,B) -->
1152 "while",ws,"(",!,ws,A,ws,")",ws_,"do",ws_,B,(Indent;ws_),"end".
1153
1154if_(python,Indent,A,B) -->
1155 "if",indented_block(A),!,B.
1156if_(perl,Indent,A,B) --> if_(c,Indent,A,B),!.
1157if_('c++',Indent,A,B) --> if_(c,Indent,A,B),!.
1158if_('java',Indent,A,B) --> if_(c,Indent,A,B),!.
1159if_('php',Indent,A,B) --> if_(c,Indent,A,B),!.
1160if_('haxe',Indent,A,B) --> if_(c,Indent,A,B),!.
1161if_('c#',Indent,A,B) --> if_(c,Indent,A,B),!.
1162if_('d',Indent,A,B) --> if_(c,Indent,A,B),!.
1163if_(javascript,Indent,A,B) -->
1164 "if",ws,"(",!,ws,A,ws,")",{writeln('calling if_')},!,ws,"{",!,ws,B,(Indent;ws),"}",!.
1165if_(c,Indent,A,B) -->
1166 "if",ws,"(",!,ws,A,ws,")",!,ws,"{",!,ws,B,(Indent;ws),"}",!.
1167if_(ruby,Indent,A,B) --> if_(lua,Indent,A,B).
1168if_(lua,Indent,A,B) -->
1169 ("if",ws_,A,ws_,"then",ws_,B).
1170
1171true_(python) --> "True".
1172true_(c) --> "true".
1173true_(php) --> "true".
1174true_(ruby) --> "true".
1175true_(haxe) --> "true".
1176true_(java) --> "true".
1177true_(javascript) --> "true".
1178true_(lua) --> "true".
1179true_('c++') --> "true".
1180true_('c#') --> "true".
1181true_('perl') --> "true".
1182true_('prolog') --> "true".
1183
1184
1185false_(python) --> "False".
1186false_(c) --> "false".
1187false_(php) --> "false".
1188false_(haxe) --> "false".
1189false_(java) --> "false".
1190false_(javascript) --> "false".
1191false_('c++') --> "false".
1192false_(perl) --> "false".
1193false_(lua) --> "false".
1194false_('c#') --> "false".
1195false_('ruby') --> "false".
1196false_(prolog) --> "false".
1197
1198
1199if_without_else(python,Indent,A,B) --> if_(python,Indent,A,B).
1200if_without_else(c,Indent,A,B) --> if_(c,Indent,A,B),!.
1201if_without_else(java,Indent,A,B) --> if_(c,Indent,A,B),!.
1202if_without_else(javascript,Indent,A,B) --> if_(c,Indent,A,B),!.
1203if_without_else('c#',Indent,A,B) --> if_(c,Indent,A,B),!.
1204if_without_else('c++',Indent,A,B) --> if_(c,Indent,A,B),!.
1205if_without_else('perl',Indent,A,B) --> if_(c,Indent,A,B),!.
1206if_without_else('haxe',Indent,A,B) --> if_(c,Indent,A,B),!.
1207if_without_else('php',Indent,A,B) --> if_(c,Indent,A,B),!.
1208if_without_else('ruby',Indent,A,B) --> if_(ruby,Indent,A,B),(Indent;ws_),"end".
1209if_without_else('lua',Indent,A,B) --> if_(lua,Indent,A,B),(Indent;ws_),"end".
1210
1211
1212contains_(python,_,Container,Contained) --> (Contained,ws_,"in",ws_,Container).
1214contains_(javascript,_,Container,Contained) -->
1215 Container,ws,".",ws,"indexOf",ws,"(",!,ws,Contained,ws,")",ws,"!==",!,ws,"-1".
1216contains_(javascript,[array,_],Container,Contained) -->
1217 Container,ws,".",ws,"includes",ws,"(",!,ws,Contained,ws,")".
1219contains_(ruby,_,Container,Contained) -->
1220 (Container,ws,".",ws,"include?",!,ws,"(",!,ws,Contained,ws,")").
1221contains_(swift,[array,_],Container,Contained) -->
1222 ("contains",ws,"(",!,ws,Container,ws,",",!,ws,Contained,ws,")").
1223contains_(prolog,[array,_],Container,Contained) -->
1224 ("member",ws,"(",!,ws,Container,ws,",",!,ws,Contained,ws,")").
1225contains_('c#',[array,_],Container,Contained) -->
1226 (Container,ws,".",ws,"Contains",ws,"(",ws,Contained,ws,")").
1227contains_('haskell',[array,_],Container,Contained) -->
1228 ("(",!,ws,"elem",ws_,Contained,ws_,Container,ws,")").
1229contains_('java',[array,_],Container,Contained) -->
1230 ("Arrays",ws,".",ws,"asList",ws,"(",ws,Container,ws,")",ws,".",ws,"contains",ws,"(",ws,Contained,ws,")").
1231contains_('haxe',[array,_],Container,Contained) -->
1232 ("Lambda",ws,".",ws,"has",ws,"(",!,ws,Container,ws,",",ws,Contained,ws,")").
1233contains_('php',[array,_],Container,Contained) -->
1234 ("in_array",ws,"(",!,ws,Contained,ws,",",!,ws,Container,ws,")").
1235contains_('c++',[array,_],Container,Contained) -->
1236 1237 "(std::find(std::begin(",ws,Container,ws,"), std::end(",ws,Container,ws,"),",ws,Contained,ws,") != std::end(",ws,Contained,ws,"))".
1238contains_('lua',[array,_],Container,Contained) -->
1239 (Container,ws,"[",ws,Contained,ws,"]",ws,"~=",ws,"nil").
1240
1241foreach_('python',Indent,Type,Var,Array,Body) -->
1242 ("for",python_ws_,Var,python_ws_,"in",python_ws_,Array,python_ws,":",python_ws,Body).
1243foreach_('javascript',Indent,Type,Var,Array,Body) -->
1244 (Array,ws,".",ws,"forEach",ws,"(",!,ws,"function",ws,"(",!,ws,Var,ws,")",ws,"{",ws,Body,(Indent;ws),"}",ws,")",ws,";").
1245foreach_('haxe',Indent,Type,Var,Array,Body) -->
1246 ("for",ws,"(",!,ws,Var,ws_,"in",ws_,Array,ws,")",ws,"{",!,ws,Body,(Indent;ws),"}"),!.
1247foreach_('ruby',Indent,_,Var,Array,Body) -->
1248 Array,ws,".",ws,"each",ws_,"do",ws,"|",ws,Var,ws,"|",ws,Body,(Indent;ws_),"end".
1249foreach_('c++',Indent,Type,Var,Array,Body) -->
1250 "for",ws,"(",!,ws,Type,ws_,Var,ws,":",ws,Array,ws,")",ws,"{",!,ws,Body,(Indent;ws),"}",!.
1251foreach_('php',Indent,_,Var,Array,Body) -->
1252 "foreach",ws,"(",!,ws,Array,ws_,"as",ws_,Var,ws,")",ws,"{",!,ws,Body,(Indent;ws),"}",!.
1253foreach_('c#',Indent,Type,Var,Array,Body) -->
1254 "foreach",ws,"(",!,ws,Type,ws_,Var,ws_,"in",ws_,Array,ws,")",ws,"{",!,ws,Body,(Indent;ws),"}",!.
1255foreach_('java',Indent,Type,Var,Array,Body) -->
1256 "for",ws,"(",!,ws,Type,ws_,Var,ws,":",ws,Array,ws,")",ws,"{",!,ws,Body,(Indent;ws),"}",!.
1257foreach_('perl',Indent,_,Var,Array,Body) -->
1258 "for",ws_,Var,ws_,"(",!,ws,Array,ws,")",ws,"{",!,ws,Body,(Indent;ws),"}",!.
1259foreach_('lua',Indent,_,Var,Array,Body) -->
1260 ("for",ws_,"_",ws,",",ws,Var,ws_,"in",ws_,"pairs",ws,"(",!,ws,Array,ws,")",ws_,"do",ws_,Body,(Indent;ws_),"end").
1261
1262statement_with_semicolon_(prolog,_,A) --> A.
1263statement_with_semicolon_(python,_,A) --> A,python_ws.
1264statement_with_semicolon_(python,_,A) --> A,";",!,ws.
1265statement_with_semicolon_(swift,_,A) --> A.
1266statement_with_semicolon_(erlang,_,A) --> A.
1267statement_with_semicolon_(java,_,A) --> A,";",!.
1268statement_with_semicolon_(minizinc,_,A) --> A,";",!.
1269statement_with_semicolon_('c++',_,A) --> A,";",!.
1270statement_with_semicolon_('c',_,A) --> A,";",!.
1271statement_with_semicolon_(lua,_,A) --> A.
1272statement_with_semicolon_(ruby,_,A) --> A.
1273statement_with_semicolon_(perl,_,A) --> A,";",!.
1274statement_with_semicolon_('c#',_,A) --> A,";",!.
1275statement_with_semicolon_(haxe,_,A) --> A,";",!.
1276statement_with_semicolon_(dart,_,A) --> A,";",!.
1277statement_with_semicolon_(php,_,A) --> A,";",!.
1278statement_with_semicolon_(javascript,_,A) --> A,";",!.
1279
1280optional_indent(prolog,Indent) --> (Indent;"").
1281optional_indent(sympy,Indent) --> Indent.
1282optional_indent(cython,Indent) --> Indent.
1283optional_indent(python,Indent) --> Indent.
1284optional_indent(swift,Indent) --> (Indent;"").
1285optional_indent(erlang,Indent) --> (Indent;"").
1286optional_indent(java,Indent) --> (Indent;ws).
1287optional_indent(minizinc,Indent) --> (Indent;ws).
1288optional_indent('c++',Indent) --> (Indent;ws).
1289optional_indent('c',Indent) --> (Indent;ws).
1290optional_indent(lua,Indent) --> (Indent;ws).
1291optional_indent(ruby,Indent) --> (Indent;ws).
1292optional_indent(perl,Indent) --> (Indent;ws).
1293optional_indent('c#',Indent) --> (Indent;ws).
1294optional_indent(haxe,Indent) --> (Indent;ws).
1295optional_indent(dart,Indent) --> (Indent;ws).
1296optional_indent(php,Indent) --> (Indent;ws).
1297optional_indent(javascript,Indent) --> (Indent;ws).
1298
1301
1302varargs_(javascript,Type,Name) --> "...",Name.
1303varargs_(php,Type,Name) -->
1304 Type,ws,"...",ws_,"$",ws,Name.
1305varargs_(java,Type,Name) -->
1306 Type,ws,"...",ws_,Name